; $Id: example-gui.lisp 16 2014-08-02 14:25:14Z admin@en-circle.com $
; Example for vacuum cleaning agent - graphics version
;  S. Russel & P. Norvig: Artifical Intelligence A Modern Approach - page 36

; Copyright (c) 2014 Peter Vanusanik <admin@en-circle.com>
;
;Permission is hereby granted, free of charge, to any person obtaining a copy
;of this software and associated documentation files (the "Software"), to deal
;in the Software without restriction, including without limitation the rights
;to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;copies of the Software, and to permit persons to whom the Software is
;furnished to do so, subject to the following conditions:
;
;The above copyright notice and this permission notice shall be included in
;all copies or substantial portions of the Software.
;
;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;THE SOFTWARE.

(load "../cl-ass.lisp")
(load "../capi-loader.lisp")

(defenvironment dirty-flatland 
                ((current-agent-position :initform 0 :accessor agent-position)
                 (flatland :initform nil :accessor flatland)))

(defmethod agent-tile ((e dirty-flatland))
  (aref (flatland e) (agent-position e)))

(defmethod clean-agent-tile ((e dirty-flatland))
  (setf (aref (flatland e) (agent-position e))
        :clean))

(defmethod left ((e dirty-flatland))
  (setf (agent-position e) 
        (max 0
             (1- (agent-position e)))))

(defmethod right ((e dirty-flatland))
  (setf (agent-position e)
        (min (1- (length (flatland e)))
             (1+ (agent-position e)))))

(defmethod initialize-environment ((e dirty-flatland) s)
  (let* ((len (+ 5 (random 4)))
        (pos (random len)))
    (let ((vec (make-array len)))
      (dotimes (i len)
        (setf (aref vec i)
              (if (= (random 2) 0)
                  :dirty
                :clean)))
      (setf (agent-position e) pos)
      (setf (flatland e) vec))))

(defagent vacuum-cleaner ((cleaned-tiles :initform 0 :accessor cleaned-tiles)))

(defpercept is-dirty? ((agent vacuum-cleaner) e)
  (eq (agent-tile e) :dirty))

(defactuator suck ((agent vacuum-cleaner) e)
  (clean-agent-tile e))

(defactuator go-left ((agent vacuum-cleaner) e)
  (left e))

(defactuator go-right ((agent vacuum-cleaner) e)
  (right e))

(defactuator contemplate ((agent vacuum-cleaner) e)
  )

(defmethod agent-function ((agent vacuum-cleaner))
  (with-slots (is-dirty?) agent
    (cond (is-dirty? (incf (cleaned-tiles agent))
                     (list 'suck))
          (t (let ((a (random 3)))
               (cond ((= a 0) (list 'contemplate))
                     ((= a 1) (list 'go-left))
                     (t (list 'go-right))))))))

(defgsimulation vacuum-cleaner-simulation ((graphics :accessor graphics :initform nil)) dirty-flatland (vacuum-cleaner) ())

(defmethod clear-pane :after ((s vacuum-cleaner-simulation) pane)
  (unless (graphics s)
    (let ((r (render-panel s)))
      (setf (graphics s)
            (list (cons :clean   (gp:convert-external-image r (gp:read-external-image "images/empty.png")))
                  (cons :dirty   (gp:convert-external-image r (gp:read-external-image "images/dirty.png")))
                  (cons :c-agent (gp:convert-external-image r (gp:read-external-image "images/empty_agent.png")))
                  (cons :d-agent (gp:convert-external-image r (gp:read-external-image "images/dirty_agent.png"))))))))

(defmethod clear-pane ((s vacuum-cleaner-simulation) pane)
  (gp:clear-graphics-port pane))

(defmethod render-pane ((s vacuum-cleaner-simulation) pane)
  (let ((e (environment s)))
    (let ((xpos 10))
      (dotimes (i (length (flatland e)))
        (let ((type (aref (flatland e) i)))
          (if (= i (agent-position e))
              (draw-agent s pane type xpos)
            (draw-empty s pane type xpos))
          (incf xpos 85))))))

(defun draw-agent (s pane type xpos)
  (draw-tile (assoc (if (eq type :dirty) :d-agent :c-agent) (graphics s)) pane xpos))

(defun draw-empty (s pane type xpos)
  (draw-tile (assoc type (graphics s)) pane xpos))

(defun draw-tile (img pane xpos)
  (gp:draw-image pane (cdr img) xpos 50))

#|
(setf *sim* (make-instance 'vacuum-cleaner-simulation))
|#
